PC Answers 1995 May/PC Answers CD-ROM 7 (Future Publishing) (May 1995).iso/vbits/code/mee/vbdao/visdata/vbimex.frm

Visual Basic Form | 1994-10-06 | 6.0 KB | 219 lines

VERSION 2.00
Begin Form VBIMEX
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "VisData Imp/Exp"
   ClientHeight    =   5295
   ClientLeft      =   2175
   ClientTop       =   1935
   ClientWidth     =   4725
   ControlBox      =   0   'False
   Height          =   5700
   Left            =   2115
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5295
   ScaleWidth      =   4725
   Top             =   1590
   Width           =   4845
   Begin CommandButton cCloseBtn
      Cancel          =   -1  'True
      Caption         =   "&Close"
      Height          =   375
      Left            =   2400
      TabIndex        =   4
      Top             =   120
      Width           =   2055
   End
   Begin CommandButton cExportSQL
      Caption         =   "Export &SQL Results"
      Enabled         =   0   'False
      Height          =   375
      Left            =   2400
      TabIndex        =   0
      Top             =   600
      Width           =   2055
   End
   Begin CommandButton cImportBtn
      Caption         =   "&Import"
      Height          =   375
      Left            =   240
      TabIndex        =   1
      Top             =   120
      Width           =   2055
   End
   Begin ListBox cTables
      Height          =   4125
      Left            =   120
      MultiSelect     =   2  'Extended
      TabIndex        =   3
      Tag             =   "OLS"
      Top             =   1080
      Width           =   4470
   End
   Begin CommandButton cExportBtn
      Caption         =   "&Export Table(s)"
      Enabled         =   0   'False
      Height          =   375
      Left            =   240
      TabIndex        =   2
      Top             =   600
      Width           =   2055
   End
   Begin CommonDialog CMD1
      Left            =   3840
      Top             =   120
   End
Sub cCloseBtn_Click ()
  Unload Me
End Sub
Sub cExportBtn_Click ()
  On Error GoTo ExpErr
  For i = 0 To cTables.ListCount - 1
    If cTables.Selected(i) Then
      DataType.Caption = "Export '" & cTables.List(i) & "'"
      DataType.Show MODAL
      cTables.Selected(i) = False
      If gDataType <> DT_NONE Then
        If gDataType <> DT_SQLDB Then
          SetCommDlg
          CMD1.Action = 2
          If Len(CMD1.Filename) > 0 Then
            If gDataType <> DT_TABDELIM Then
              Export (cTables.List(i)), (CMD1.Filename)
            Else
              ExportTabDelim (cTables.List(i)), (CMD1.Filename)
            End If
          End If
        Else
          Export (cTables.List(i)), NULL_STR
        End If
      End If
    End If
  Next
  cExportBtn.Enabled = False
  Exit Sub
ExpErr:
  If Err = 32755 Then Exit Sub
  ShowError
  Exit Sub
End Sub
Sub cExportSQL_Click ()
  On Error GoTo SQLExpErr
  DataType.Caption = "Export '" & cTables.List(i) & "'"
  DataType.Show MODAL
  If gDataType <> DT_NONE Then
    If gDataType <> DT_SQLDB Then
      SetCommDlg
      CMD1.Action = 2
      If Len(CMD1.Filename) > 0 Then
        If gDataType <> DT_TABDELIM Then
          Export NULL_STR, (CMD1.Filename)
        Else
          ExportTabDelim NULL_STR, (CMD1.Filename)
        End If
      End If
    Else
      Export NULL_STR, NULL_STR
    End If
  End If
  Exit Sub
SQLExpErr:
  If Err = 32755 Then Exit Sub
  ShowError
  Exit Sub
End Sub
Sub cImportBtn_Click ()
  On Error GoTo ImpErr
  DataType.Caption = "Import"
  DataType.Show MODAL
  If gDataType = DT_NONE Then Exit Sub
  If gDataType <> DT_SQLDB Then
    SetCommDlg
    CMD1.Action = 1
    If Len(CMD1.Filename) > 0 Then
      If gDataType = DT_MSACCESS Or gDataType = DT_BTRIEVE Then
        If gDataType = DT_MSACCESS Then
          Set gImpDB = OpenDatabase(CMD1.Filename)
        Else
          Set gImpDB = OpenDatabase(CMD1.Filename, 0, 0, "Btrieve")
        End If
        If gImpDB Is Nothing Then Exit Sub
        ImpTbls.Label1 = ImpTbls.Label1 + gImpDB.Name
        ImpTbls.Show MODAL
      Else
        Import (CMD1.Filename)
        While Len(CMD1.Filename) > 0
          CMD1.Filename = NULL_STR
          CMD1.Action = 1
          Import (CMD1.Filename)
        Wend
      End If
    End If
  Else
    Set gImpDB = OpenDatabase("", 0, 0, "odbc;")
    If gImpDB Is Nothing Then Exit Sub
    ImpTbls.Label1 = ImpTbls.Label1 + gImpDB.Name
    ImpTbls.Show MODAL
  End If
  Exit Sub
ImpErr:
  If Err = 32755 Then Exit Sub
  ShowError
  Exit Sub
End Sub
Sub cTables_Click ()
  cExportBtn.Enabled = True
End Sub
Sub cTables_DblClick ()
  Call cExportBtn_Click
End Sub
Sub Form_Load ()
   Set gDB = gCurrentDB
   If UCase(Mid(fSQL.cSQLStatement, 1, 7)) = "SELECT " Then
     cExportSQL.Enabled = True
   End If
   IMEXRefreshTables
   MsgBar "", False
End Sub
Sub Form_Paint ()
  Outlines Me
End Sub
Sub Form_Resize ()
  If WindowState <> 2 Then
    cTables.Width = Width - 340
    Call Form_Paint
    Refresh
  End If
End Sub
Sub Form_Unload (Cancel As Integer)
  Unload DataType
End Sub
Sub SetCommDlg ()
   CMD1.DialogTitle = "Select File"
   Select Case gDataType
     Case DT_MSACCESS
       CMD1.Filter = "Microsoft Access (*.mdb)|*.mdb|All Files (*.*)|*.*"
       CMD1.DialogTitle = "Select Microsoft Access Database"
     Case DT_PARADOX
       CMD1.Filter = "Paradox (*.db)|*.db"
     Case DT_FOXPRO25
       CMD1.Filter = "FoxPro 2.5 (*.dbf)|*.dbf"
     Case DT_FOXPRO20
       CMD1.Filter = "FoxPro 2.0 (*.dbf)|*.dbf"
     Case DT_DBASEIV
       CMD1.Filter = "dBASE IV (*.dbf)|*.dbf"
     Case DT_DBASEIII
       CMD1.Filter = "dBASE III (*.dbf)|*.dbf"
     Case DT_BTRIEVE
       CMD1.Filter = "Btrieve (FILE.DDF)|FILE.DDF"
     Case DT_TABDELIM
       CMD1.Filter = "Text Files (*.txt)|*.txt|All Files (*.*)|*.*"
       CMD1.DialogTitle = "Select Text File"
   End Select
   CMD1.FilterIndex = 1
   CMD1.Filename = ""
   CMD1.CancelError = True
End Sub